home *** CD-ROM | disk | FTP | other *** search
/ Aminet 45 / Aminet 45 (2001)(GTI - Schatztruhe)[!][Oct 2001].iso / Aminet / dev / e / yaec.lha / examples / ScrollerWindow.e < prev    next >
Text File  |  2001-08-12  |  10KB  |  310 lines
  1. /* ScrollerWindow.e
  2.  
  3.    Translated by Wouter from excellent example scrollerwindow.c
  4.    by Christoph Feck, TowerSystems (feck@informatik.uni-kl.de)
  5.  
  6.    needs E v2.1b / v39 emodules with fixed icclass.m to compile
  7.  
  8. */    
  9.  
  10. MODULE 'exec/memory', 'utility', 'exec/libraries', 'utility/tagitem',
  11.        'intuition/intuition', 'intuition/imageclass', 'intuition/screens',
  12.        'intuition/classes', 'intuition/icclass', 'intuition/gadgetclass',
  13.        'intuition/imageclass',
  14.        'graphics/gfx', 'graphics/text', 'graphics/rastport'
  15.  
  16. DEF screen:PTR TO screen,dri:PTR TO drawinfo,v39,bitmap:PTR TO bitmap
  17.  
  18. DEF horizgadget:PTR TO object,vertgadget:PTR TO object,
  19.     leftgadget:PTR TO object,rightgadget:PTR TO object,
  20.     upgadget:PTR TO object,downgadget:PTR TO object
  21.  
  22. ENUM HORIZ_GID=1,VERT_GID,LEFT_GID,RIGHT_GID,UP_GID,DOWN_GID
  23.  
  24. DEF window:PTR TO window
  25.  
  26. -> these are actually PTR TO object too
  27.  
  28. DEF sizeimage:PTR TO image,leftimage:PTR TO image,rightimage:PTR TO image,
  29.     upimage:PTR TO image,downimage:PTR TO image
  30.  
  31. DEF htotal,vtotal,hvisible,vvisible
  32.  
  33. PROC max(x,y) IS IF x>y THEN x ELSE y
  34. PROC min(x,y) IS IF x<y THEN x ELSE y
  35. PROC rassize(w,h) IS Shr(w+15,3) AND $FFFE * h
  36.  
  37. PROC createbitmap(width,height,depth,flags,friend:PTR TO bitmap)
  38.   DEF bm:PTR TO bitmap,memflags,pl:PTR TO LONG,i
  39.   IF v39
  40.     bm:=AllocBitMap(width,height,depth,flags,friend)
  41.   ELSE
  42.     memflags:=MEMF_CHIP
  43.     IF bm:=New(SIZEOF bitmap)
  44.       InitBitMap(bm,depth,width,height)
  45.       pl:=bm.planes
  46.       IF flags AND BMF_CLEAR THEN memflags:=memflags OR MEMF_CLEAR
  47.       pl[0]:=AllocVec(depth*rassize(width,height),memflags)
  48.       IF pl[0]
  49.         FOR i:=1 TO depth-1 DO pl[i]:=pl[i-1]+rassize(width,height)
  50.       ELSE
  51.         Dispose(bm)
  52.       ENDIF
  53.     ENDIF
  54.   ENDIF
  55. ENDPROC bm
  56.  
  57. PROC deletebitmap(bm:PTR TO bitmap)
  58.   IF bm
  59.     IF v39
  60.       FreeBitMap(bm)
  61.      ELSE
  62.        FreeVec(Long(bm.planes))
  63.        Dispose(bm)
  64.      ENDIF
  65.   ENDIF
  66. ENDPROC
  67.  
  68. PROC bitmapdepth(bm:PTR TO bitmap)
  69. ENDPROC IF v39 THEN GetBitMapAttr(bm,BMA_DEPTH) ELSE bm.depth
  70.  
  71. PROC sysisize()
  72. ENDPROC IF screen.flags AND SCREENHIRES THEN SYSISIZE_MEDRES ELSE SYSISIZE_LOWRES
  73.  
  74.  
  75. PROC newimageobject(which) IS NewObjectA(NIL,'sysiclass',
  76.     [SYSIA_DRAWINFO,dri,SYSIA_WHICH,which,SYSIA_SIZE,sysisize(),NIL])
  77.  
  78.  
  79. PROC newpropobject(freedom,taglist) IS NewObjectA(NIL,'propgclass',
  80.     [ICA_TARGET,ICTARGET_IDCMP,PGA_FREEDOM,freedom,PGA_NEWLOOK,TRUE,
  81.      PGA_BORDERLESS,(dri.flags AND DRIF_NEWLOOK) AND (dri.depth<>1),
  82.      TAG_MORE,taglist])
  83.  
  84. PROC newbuttonobject(image:PTR TO object,taglist) IS NewObjectA(
  85.     NIL,'buttongclass',
  86.     [ICA_TARGET,ICTARGET_IDCMP,GA_IMAGE,image,TAG_MORE,taglist])
  87.  
  88.  
  89. PROC openscrollerwindow(taglist)
  90.   DEF resolution,topborder,sf:PTR TO textattr,w,h,bw,bh,rw,rh,gw,gh,gap
  91.   resolution:=sysisize()
  92.   sf:=screen.font
  93.   topborder:=screen.wbortop+sf.ysize+1
  94.   w:=sizeimage.width
  95.   h:=sizeimage.height
  96.   bw:=IF resolution=SYSISIZE_LOWRES THEN 1 ELSE 2
  97.   bh:=IF resolution=SYSISIZE_HIRES THEN 2 ELSE 1
  98.   rw:=IF resolution=SYSISIZE_HIRES THEN 3 ELSE 2
  99.   rh:=IF resolution=SYSISIZE_HIRES THEN 2 ELSE 1
  100.   gh:=max(leftimage.height,h)
  101.   gh:=max(rightimage.height,gh)
  102.   gw:=max(upimage.width,w)
  103.   gw:=max(downimage.width,gw)
  104.   gap:=1
  105.   horizgadget:=newpropobject(FREEHORIZ,
  106.     [GA_LEFT,rw+gap,
  107.      GA_RELBOTTOM,bh-gh+2,
  108.      GA_RELWIDTH,(-gw)-gap-leftimage.width-rightimage.width-rw-rw,
  109.      GA_HEIGHT,gh-bh-bh-2,
  110.      GA_BOTTOMBORDER,TRUE,
  111.      GA_ID,HORIZ_GID,
  112.      PGA_TOTAL,htotal,
  113.      PGA_VISIBLE,hvisible,
  114.      NIL])
  115.   vertgadget:=newpropobject(FREEVERT,
  116.     [GA_RELRIGHT,bw-gw+3,
  117.      GA_TOP,topborder+rh,
  118.      GA_WIDTH,gw-bw-bw-4,
  119.      GA_RELHEIGHT,(-topborder)-h-upimage.height-downimage.height-rh-rh,
  120.      GA_RIGHTBORDER,TRUE,
  121.      GA_PREVIOUS,horizgadget,
  122.      GA_ID,VERT_GID,
  123.      PGA_TOTAL,vtotal,
  124.      PGA_VISIBLE,vvisible,
  125.      NIL])
  126.   leftgadget:=newbuttonobject(leftimage,
  127.     [GA_RELRIGHT,(1)-leftimage.width-rightimage.width-gw,
  128.      GA_RELBOTTOM,(1)-leftimage.height,
  129.      GA_BOTTOMBORDER,TRUE,
  130.      GA_PREVIOUS,vertgadget,
  131.      GA_ID,LEFT_GID,
  132.      NIL])
  133.   rightgadget:=newbuttonobject(rightimage,
  134.     [GA_RELRIGHT,(1)-rightimage.width-gw,
  135.      GA_RELBOTTOM,(1)-rightimage.height,
  136.      GA_BOTTOMBORDER,TRUE,
  137.      GA_PREVIOUS,leftgadget,
  138.      GA_ID,RIGHT_GID,
  139.      NIL])
  140.   upgadget:=newbuttonobject(upimage,
  141.     [GA_RELRIGHT,(1)-upimage.width,
  142.      GA_RELBOTTOM,(1)-upimage.height-downimage.height-h,
  143.      GA_RIGHTBORDER,TRUE,
  144.      GA_PREVIOUS,rightgadget,
  145.      GA_ID,UP_GID,
  146.      NIL])
  147.   downgadget:=newbuttonobject(downimage,
  148.     [GA_RELRIGHT,(1)-downimage.width,
  149.      GA_RELBOTTOM,(1)-downimage.height-h,
  150.      GA_RIGHTBORDER,TRUE,
  151.      GA_PREVIOUS,upgadget,
  152.      GA_ID,DOWN_GID,
  153.      NIL])
  154.   IF downgadget
  155.     window:=OpenWindowTagList(NIL,
  156.       [WA_GADGETS,horizgadget,
  157.        WA_MINWIDTH,max(80,gw+gap+leftimage.width+rightimage.width+rw+rw+KNOBHMIN),
  158.        WA_MINHEIGHT,max(50,topborder+h+upimage.height+downimage.height+rh+rh+KNOBVMIN),
  159.        TAG_MORE,taglist])
  160.   ENDIF
  161. ENDPROC
  162.  
  163. PROC closescrollerwindow()
  164.   IF window THEN CloseWindow(window)
  165.   DisposeObject(horizgadget)
  166.   DisposeObject(vertgadget)
  167.   DisposeObject(leftgadget)
  168.   DisposeObject(rightgadget)
  169.   DisposeObject(upgadget)
  170.   DisposeObject(downgadget)
  171. ENDPROC
  172.  
  173. PROC recalchvisible() IS window.width-window.borderleft-window.borderright
  174. PROC recalcvvisible() IS window.height-window.bordertop-window.borderbottom
  175.  
  176. PROC updateprop(gadget:PTR TO object,attr,value)
  177. ENDPROC SetGadgetAttrsA(gadget,window,NIL,[attr,value,NIL])
  178.  
  179.  
  180. PROC copybitmap()
  181.   DEF srcx,srcy
  182.   GetAttr(PGA_TOP,horizgadget,{srcx})
  183.   GetAttr(PGA_TOP,vertgadget,{srcy})
  184.   BltBitMapRastPort(bitmap,srcx,srcy,window.rport,window.borderleft,
  185.     window.bordertop,min(htotal,hvisible),min(vtotal,vvisible),$C0)
  186. ENDPROC
  187.  
  188. PROC updatescrollerwindow()
  189.   hvisible:=recalchvisible()
  190.   updateprop(horizgadget,PGA_VISIBLE,hvisible)
  191.   vvisible:=recalcvvisible()
  192.   updateprop(vertgadget,PGA_VISIBLE,vvisible)
  193.   copybitmap()
  194. ENDPROC
  195.  
  196. PROC handlescrollerwindow()
  197.   DEF imsg:PTR TO intuimessage,quit=FALSE,oldtop,cl,v
  198.   WHILE quit=FALSE
  199.     WHILE (quit=FALSE) AND (imsg:=GetMsg(window.userport))
  200.       cl:=imsg.class
  201.       SELECT cl
  202.         CASE IDCMP_CLOSEWINDOW
  203.           quit:=TRUE
  204.         CASE IDCMP_NEWSIZE
  205.           updatescrollerwindow()
  206.         CASE IDCMP_REFRESHWINDOW
  207.           BeginRefresh(window)
  208.           copybitmap()
  209.           EndRefresh(window,TRUE)
  210.         CASE IDCMP_IDCMPUPDATE
  211.           v:=GetTagData(GA_ID,0,imsg.iaddress)
  212.           SELECT v
  213.             CASE HORIZ_GID
  214.               copybitmap()
  215.             CASE VERT_GID
  216.               copybitmap()
  217.             CASE LEFT_GID
  218.               GetAttr(PGA_TOP,horizgadget,{oldtop})
  219.               IF oldtop>0
  220.                 updateprop(horizgadget,PGA_TOP,oldtop-1)
  221.                 copybitmap()
  222.               ENDIF
  223.             CASE RIGHT_GID
  224.               GetAttr(PGA_TOP,horizgadget,{oldtop})
  225.               IF oldtop<(htotal-hvisible)
  226.                 updateprop(horizgadget,PGA_TOP,oldtop+1)
  227.                 copybitmap()
  228.               ENDIF
  229.             CASE UP_GID
  230.               GetAttr(PGA_TOP,vertgadget,{oldtop})
  231.               IF oldtop>0
  232.                 updateprop(vertgadget,PGA_TOP,oldtop-1)
  233.                 copybitmap()
  234.               ENDIF
  235.             CASE DOWN_GID
  236.               GetAttr(PGA_TOP,vertgadget,{oldtop})
  237.               IF oldtop<(vtotal-vvisible)
  238.                 updateprop(vertgadget,PGA_TOP,oldtop+1)
  239.                 copybitmap()
  240.               ENDIF
  241.           ENDSELECT
  242.       ENDSELECT
  243.       ReplyMsg(imsg)
  244.     ENDWHILE
  245.     IF quit=FALSE THEN WaitPort(window.userport)
  246.   ENDWHILE
  247. ENDPROC
  248.  
  249. PROC doscrollerwindow()
  250.   DEF r:PTR TO rastport
  251.   IF screen:=LockPubScreen(NIL)
  252.     hvisible:=htotal:=screen.width
  253.     vvisible:=vtotal:=screen.height
  254.     r:=screen.rastport
  255.     IF bitmap:=createbitmap(htotal,vtotal,bitmapdepth(r.bitmap),0,r.bitmap)
  256.       BltBitMap(r.bitmap,0,0,bitmap,0,0,htotal,vtotal,$C0,-1,NIL)
  257.       IF dri:=GetScreenDrawInfo(screen)
  258.         sizeimage:=newimageobject(SIZEIMAGE)
  259.         leftimage:=newimageobject(LEFTIMAGE)
  260.         rightimage:=newimageobject(RIGHTIMAGE)
  261.         upimage:=newimageobject(UPIMAGE)
  262.         downimage:=newimageobject(DOWNIMAGE)
  263.         IF (sizeimage<>0) AND (leftimage<>0) AND (rightimage<>0) AND (upimage<>0) AND (downimage<>0)
  264.           openscrollerwindow([WA_PUBSCREEN,screen,
  265.             WA_TITLE,'ScrollerWindow',
  266.             WA_FLAGS,WFLG_CLOSEGADGET OR WFLG_SIZEGADGET OR WFLG_DRAGBAR OR WFLG_DEPTHGADGET OR WFLG_SIMPLE_REFRESH OR WFLG_ACTIVATE OR WFLG_NEWLOOKMENUS,
  267.             WA_IDCMP,IDCMP_CLOSEWINDOW OR IDCMP_NEWSIZE OR IDCMP_REFRESHWINDOW OR IDCMP_IDCMPUPDATE,
  268.             WA_INNERWIDTH,htotal,
  269.             WA_INNERHEIGHT,vtotal,
  270.             WA_MAXWIDTH,-1,
  271.             WA_MAXHEIGHT,-1,
  272.             NIL])
  273.           IF window
  274.             updatescrollerwindow()
  275.             handlescrollerwindow()
  276.           ELSE
  277.             WriteF('no window!\n')
  278.           ENDIF
  279.           closescrollerwindow()
  280.         ELSE
  281.           WriteF('no images!\n')
  282.         ENDIF
  283.         DisposeObject(sizeimage)
  284.         DisposeObject(leftimage)
  285.         DisposeObject(rightimage)
  286.         DisposeObject(upimage)
  287.         DisposeObject(downimage)
  288.         FreeScreenDrawInfo(screen,dri)
  289.       ELSE
  290.         WriteF('no draw infos!\n')
  291.       ENDIF
  292.       WaitBlit()
  293.       deletebitmap(bitmap)
  294.     ELSE
  295.       WriteF('no bitmap!\n')
  296.     ENDIF
  297.     UnlockPubScreen(NIL,screen)
  298.   ELSE
  299.     WriteF('no pub screen!\n')
  300.   ENDIF
  301. ENDPROC
  302.  
  303. PROC main()
  304.   v39:=KickVersion(39)
  305.   IF (utilitybase:=OpenLibrary('utility.library',37))
  306.     doscrollerwindow()
  307.     CloseLibrary(utilitybase)
  308.   ENDIF
  309. ENDPROC
  310.